home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / colorset.zip / COLORSET.PRG < prev    next >
Text File  |  1993-01-04  |  21KB  |  847 lines
  1. * COLORSET.PRE
  2. *
  3. * GENERIC PROCEDURE allows user to interactively change colors.
  4. *
  5. * Michael K. Bozovich
  6. * 12-20-1989 <Panama Invasion Day>
  7. *
  8. *         This procedure requires linking with IDL.LIB and EXTEND.LIB in
  9. *         addition to the standard CLIPPER.LIB.
  10. *
  11. *         Global Color Variables:
  12. *
  13. *             c_scr_color - 'Normal Text' - used by most everything...
  14. *             c_err_color - 'Error Messages'
  15. *             c_msg_color - 'Status Messages'
  16. *             c_int_color - 'Screen Titles / High Intensity'
  17. *             c_inv_color - 'Input Fields  / Inverse Video / GETs'
  18. *             c_hlp_color - 'Help Screen Colors'
  19. *
  20. *         Programmer imposed limitations:
  21. *
  22. *             1.  Foreground and background colors may NOT match.
  23. *                 This combination is totally disallowed and may not
  24. *                 even be chosen by accident.
  25. *
  26. *             2.  The screen title color must have the same background
  27. *                 as the normal text color.
  28. *
  29. *             3.  The "enhanced" color for normal text is ALWAYS the
  30. *                 "standard" color for input fields and vice versa.
  31. *
  32.  
  33.  
  34.  
  35. *
  36. * Save current DOS screen attribute for clearing screen upon exit.
  37. *
  38.  
  39. save_attr = GET_ATTR()
  40.  
  41. *
  42. * Define screen colors based on graphics card detected.
  43. *
  44.  
  45. IF ! FILE("colors.mem")
  46.  
  47.   IF VID_TYPE() > 0
  48.     c_scr_color = "15/1,1/3"              && Overall Screen colors
  49.     c_err_color = "15/4"                  && Error Messages
  50.     c_msg_color = "15/2"                  && Status Messages
  51.     c_int_color = "14/1"                  && High Intensity
  52.     c_inv_color = "1/3,3/1"               && Inverse Video
  53.     c_hlp_color = "10/0"                  && Help Screen(s)
  54.   ELSE
  55.     c_scr_color = "7/0,0/7"               && Complimentary MONO colors...
  56.     c_err_color = "0/15"
  57.     c_msg_color = "0/7"
  58.     c_int_color = "15/0"
  59.     c_inv_color = "0/7,7/0"
  60.     c_hlp_color = "0/7"
  61.   ENDIF
  62.  
  63.   SAVE TO colors.mem ALL LIKE c_*
  64.  
  65. ENDIF
  66.  
  67. RESTORE FROM colors.mem ADDITIVE
  68.  
  69. SET COLOR TO (c_scr_color)
  70.  
  71. SET CURSOR OFF
  72. CLEAR SCREEN
  73.  
  74. *
  75. * This 'hidden' color variable is only used only for hiding the simulated
  76. *  wait state READ in COLORSEL below.
  77. *
  78. * It can be derived from the current screen colors.  Here is the algorithm...
  79. *
  80.  
  81. hidden = LTRIM(STR(INT(GET_ATTR() / 16), 0))
  82. hidden = hidden + "/" + hidden + "," + hidden + "/" + hidden
  83.  
  84. *
  85. * Define these variables to be 'global'.  They are used by COLORSEL and
  86. *  must be returned successfully in order to build the modified color strings.
  87. *
  88.  
  89. STORE 0 TO _attr_, fore, back
  90.  
  91. *
  92. * Draw a sample screen 'Title'
  93. *
  94.  
  95. DO Title
  96.  
  97. *
  98. * Draw the color sample box.
  99. *
  100.  
  101. @ 6, 41 TO 10, 69 DOUBLE
  102.  
  103. _str_row_ = (10 - 6) / 2 + 6
  104.  
  105. *
  106. * This next routine draws the rectangle of all possible colors that the user
  107. *  may choose from and saves the screen to a mem file.
  108. *
  109. *  The outer (i) FOR loop cycles through the possible
  110. *  BACKGROUND colors.
  111. *
  112. *  The inner (j) FOR loop cycles through the possible
  113. *  FOREGROUND colors.
  114. *
  115. *  The supplemental counter (k) is used for cursor
  116. *  positioning so that there is even spacing between the attribute numbers.
  117. *
  118. *  THIS IS UNACCEPTABLY SLOW, EVEN ON A 12-Mhz AT !!!
  119. *
  120. *  Try the following:
  121. *
  122. *        1.  Use Clipper SET COLOR TO instead of APRINT().  - Just as slow.
  123. *        2.  Draw the stupid thing in "hidden color" and use - Just as slow.
  124. *            the SET_ATTR() function to splash on the color.
  125. *        3.  Save/Restore screen from a memvar.        - Very acceptable.
  126. *
  127. *  The solution is, of course, to only draw the fucker if necessary, save it
  128. *    to a memvar file, and pop it on the screen every other time.
  129. *
  130.  
  131. IF ! FILE("attrib.mem")
  132.  
  133.   FOR i = 0 TO 7
  134.  
  135.     k = 0
  136.  
  137.     FOR j = 0 TO 15
  138.  
  139.      @ i + 13, j + (9 - 2) + k SAY ;
  140.            APRINT(" " + STRZERO(j + i * 16, 3) + " ", j + i * 16)
  141.  
  142.      k = k + 3
  143.  
  144.     NEXT j
  145.  
  146.   NEXT i
  147.  
  148.   attr_screen = SAVESCREEN(13, 9 - 2, ;
  149.                            13 + 7, 9 + 60 + 2)
  150.  
  151.   SAVE TO attrib.mem ALL LIKE attr_screen*
  152.  
  153. ENDIF
  154.  
  155. *
  156. * Restore from the screen memfile and pop up the screen.
  157. *
  158.  
  159. RESTORE FROM attrib.mem ADDITIVE
  160. RESTSCREEN(13, 9 - 2, ;
  161.            13 + 7, 9 + 60 + 2, attr_screen)
  162.  
  163. *
  164. * Set up for ACHOICE()...
  165. *
  166.  
  167. PRIVATE options[7]
  168.  
  169. options[1] = "1 - Normal Screen Text"
  170. options[2] = "2 - Screen Titles"
  171. options[3] = "3 - Input Fields"
  172. options[4] = "4 - Status Messages"
  173. options[5] = "5 - Error Messages"
  174. options[6] = "6 - Help Screens"
  175. options[7] = "7 - Save Selections"
  176.  
  177. @ 2, 9 TO 10, 34 DOUBLE
  178.  
  179. choice = 1
  180.  
  181. DO WHILE .t.
  182.  
  183.   * SET KLUDGE ON
  184.  
  185.   KEYBOARD CHR(1)       && Keep the silly thing 'synchronized' ......
  186.  
  187.   * SET KLUDGE OFF
  188.  
  189.   ACHOICE(2 + 1, 9 + 2, 10 - 1, 34 - 2, ;
  190.                                 options, .t., "showstat", choice)
  191.  
  192.   IF LASTKEY() == 27
  193.     EXIT
  194.   ENDIF
  195.  
  196. ENDDO
  197.  
  198. CLS(save_attr)
  199. SET CURSOR ON
  200.  
  201. ******************************************************************************
  202. ******************************************************************************
  203. ******************************************************************************
  204.  
  205. FUNCTION SHOWSTAT
  206.  
  207. *
  208. * This function is called from the ACHOICE() function with each keypress.
  209. *
  210. * It's main purpose is to keep the sample window screen region updated
  211. *  with the color for the currently highlited choice.
  212. *
  213. * If the <Enter> key is pressed, the actual COLORSEL routine is called
  214. *  and the user can play...
  215. *
  216. * If the <Esc> key is pressed, the value indicating 'abort' is returned
  217. *  and ACHOICE() exits.
  218. *
  219. * Note the kludge allowing wrap around within ACHOICE()...
  220. *
  221.  
  222. PARAMETERS mode, index, win_pos
  223.  
  224. *
  225. * This little kludge stores the current attribute of the menu hilite so we
  226. *  can KEEP it hilited while in the keystroke exception, even though ACHOICE
  227. *  normally does not.
  228. *
  229.  
  230. SET COLOR TO (c_inv_color)
  231. item_atr = FOREGROUND() + BACKGROUND() * 16
  232. SET COLOR TO (c_scr_color)
  233.  
  234. * SET FUN ON
  235.  
  236. *
  237. * Calculate a suitable 'dim' attribute so we can dim the menu while in
  238. *  COLORSEL...
  239. *
  240.  
  241. dim_attr = IF(FOREGROUND() == 7, 8, 7) + BACKGROUND() * 16
  242.  
  243. * SET FUN OFF
  244.  
  245. *
  246. * Update the sample window...
  247. *
  248.  
  249. IF index == 1                                          && Normal
  250.   SET COLOR TO (c_scr_color)
  251.   _str_ = "NORMAL TEXT"
  252.  
  253. ELSEIF index == 2                                      && Title
  254.   SET COLOR TO (c_int_color)
  255.   _str_ = "SCREEN TITLE"
  256.  
  257. ELSEIF index == 3                                      && Inverse
  258.   SET COLOR TO (c_inv_color)
  259.   _str_ = "INPUT FIELD"
  260.  
  261. ELSEIF index == 4                                      && Messages
  262.   SET COLOR TO (c_msg_color)
  263.   _str_ = "STATUS MESSAGE"
  264.  
  265. ELSEIF index == 5                                      && Error Messages
  266.   SET COLOR TO (c_err_color)
  267.   _str_ = "ERROR MESSAGE"
  268.  
  269. ELSEIF index == 6                                      && Help Screens
  270.   SET COLOR TO (c_hlp_color)
  271.   _str_ = "HELP SCREEN"
  272.  
  273. ELSEIF index == 7                                      && Save (Normal)
  274.   SET COLOR TO (c_scr_color)
  275.   _str_ = "<UNDEFINED>"
  276.  
  277. ENDIF
  278.  
  279. _str_col_ = (69 - 41 - LEN(_str_)) / 2 + 41
  280.  
  281. @ _str_row_, 41 + 1 SAY SPACE(69 - 41 - 1)
  282.  
  283. *
  284. * With the proper color turned on, say the nifty little message in the
  285. *  sample window so we can tell what it is from GET_ATTR() below...
  286. *
  287.  
  288. @ _str_row_, _str_col_ SAY _str_
  289.  
  290. *
  291. * Some of the sample box is left with the "normal text" color value.
  292. * Fill in the rest of it with this IDL command.  How handy!
  293. *
  294.  
  295. SET_ATTR(GET_ATTR(_str_row_,_str_col_),6,41,10,69)
  296.  
  297. *
  298. * Turn 'normal' color back on...
  299. *
  300.  
  301. SET COLOR TO (c_scr_color)
  302.  
  303. IF (mode == 1 .AND. LASTKEY() == 5) .OR. ;        && Allows 'wrap'
  304.    (mode == 2 .AND. LASTKEY() == 24)
  305.  
  306.   * SET KLUDGE ON
  307.  
  308.   choice = IF(mode == 1, 7, 1)
  309.  
  310.   RETURN 1
  311.  
  312.   * SET KLUDGE OFF
  313.  
  314. ELSEIF mode == 3
  315.  
  316.   *
  317.   * A key was pressed, we need to determine if it was one of our
  318.   *  two 'special' keys.
  319.   *
  320.  
  321.   IF LASTKEY() == 13
  322.  
  323.     *
  324.     * Dim the pick list region to indicate that it is not active.
  325.     * Also 're-highlite' the selected record because ACHOICE() clears
  326.     *  the highlite when the record is selected.
  327.     *
  328.  
  329.     SET_ATTR(dim_attr, 2, 9, 10, 34)
  330.     SET_ATTR(item_atr, 2 + index, 9 + 2, ;
  331.                        2 + index, 34 - 2)
  332.  
  333.     *
  334.     * If we are not 'saving',
  335.     * Do the color selection routine and let the user play...
  336.     *
  337.  
  338.     IF index # 7
  339.       DO COLORSEL
  340.     ENDIF
  341.  
  342.     *
  343.     * For each case below, a new global variable must be constructed.
  344.     *
  345.     *  Depending on the variable updated, portion(s) of the screen may
  346.     *  need to be 'refreshed'...
  347.     *
  348.     *  If it was the overall 'normal text' color that was altered, a
  349.     *  little extra work needs to be done.  Likewise with the 'input field'
  350.     *  colors.  (Inverse video)  Otherwise, the construction is straightforward
  351.     *  as demonstrated below...
  352.     *
  353.  
  354.     IF index == 1                                            && Normal
  355.  
  356.       *
  357.       *  Since the normal and inverse strings are mutually interdependent,
  358.       *   if one was altered, so must the other be.  i.e. ............
  359.       *
  360.  
  361.       c_scr_color = fore + "/" + back + "," + SUBSTR(c_inv_color, 1, AT(",", c_inv_color) - 1)
  362.  
  363.       c_inv_color = SUBSTR(c_inv_color, 1, AT(",", c_inv_color) - 1) + "," + fore + "/" + back
  364.  
  365.       *
  366.       * Since the 'title screen' colors are also used for 'high intensity'
  367.       *  in others places through the system, I am restricting the background
  368.       *  to be the same as the 'normal text' background.  The user just
  369.       *  changed the 'normal text', so the 'title screen' variable must
  370.       *  also be....
  371.       *
  372.  
  373.       c_int_color = SUBSTR(c_int_color, 1, AT("/", c_int_color)) + back
  374.  
  375.       *
  376.       * The 'hidden' color variable is only used only for hiding the simulated
  377.       *  wait state READ below.
  378.       *
  379.       *  It needs to be re-generated from the 'normal text' variable
  380.       *  each time it is changed.  Here is the algorithm...
  381.       *
  382.  
  383.       hidden = back + "/" + back + "," + back + "/" + back
  384.  
  385.       *
  386.       * IDL to the rescue!
  387.       *  To avoid redrawing the screen to reflect the new overall
  388.       *  text colors, just 'splash it on'.....    :)
  389.       *
  390.  
  391.       SET_ATTR(_attr_, 0, 0, 24, 79)
  392.  
  393.       *
  394.       * Since we just wiped out the color selection rectangle, pop it back...
  395.       *
  396.  
  397.       RESTSCREEN(13, 9 - 2, ;
  398.                  13 + 7, 9 + 60 + 2, attr_screen)
  399.  
  400.       *
  401.       * ...re-draw the title...
  402.       *
  403.  
  404.       DO Title
  405.  
  406.       *
  407.       * ...'re-dim' the menu...
  408.       *
  409.  
  410.       SET COLOR TO (c_scr_color)
  411.  
  412.       dim_attr = IF(FOREGROUND() == 7, 8, 7) + BACKGROUND() * 16
  413.  
  414.       SET_ATTR(dim_attr, 2, 9, 10, 34)
  415.  
  416.       *
  417.       * ...and 're-hilite' the current menu item.  <Whew!>
  418.       *
  419.  
  420.       SET COLOR TO (c_inv_color)
  421.       item_atr = FOREGROUND() + BACKGROUND() * 16
  422.       SET_ATTR(item_atr, 2 + index, 9 + 2, ;
  423.                          2 + index, 34 - 2)
  424.  
  425.       *
  426.       * Better tell Clipper about the global color change now...
  427.       *
  428.  
  429.       SET COLOR TO (c_scr_color)
  430.  
  431.     ELSEIF index == 2                                           && Title
  432.  
  433.       c_int_color = fore + "/" + back
  434.  
  435.       DO Title
  436.  
  437.     ELSEIF index == 3                                           && Inverse
  438.  
  439.       *
  440.       *  Since the normal and inverse strings are mutually interdependent,
  441.       *   if one was altered, so must the other be.  i.e. ............
  442.       *
  443.  
  444.       c_inv_color = fore + "/" + back + "," + SUBSTR(c_scr_color, 1, AT(",", c_scr_color) - 1)
  445.  
  446.       c_scr_color = SUBSTR(c_scr_color, 1, AT(",", c_scr_color) - 1) + "," + fore + "/" + back
  447.  
  448.       *
  449.       *  We changed the 'inverse' color, so we have to redraw the
  450.       *   current item on the menu...
  451.       *
  452.  
  453.       SET COLOR TO (c_inv_color)
  454.       item_atr = FOREGROUND() + BACKGROUND() * 16
  455.       SET COLOR TO (c_scr_color)
  456.  
  457.       SET_ATTR(item_atr, 2 + index, 9 + 2, ;
  458.                          2 + index, 34 - 2)
  459.  
  460.     ELSEIF index == 4                                      && Messages
  461.  
  462.       c_msg_color = fore + "/" + back
  463.  
  464.     ELSEIF index == 5                                      && Error Messages
  465.  
  466.       c_err_color = fore + "/" + back
  467.  
  468.     ELSEIF index == 6                                      && Help Screens
  469.  
  470.       c_hlp_color = fore + "/" + back
  471.  
  472.     ELSEIF index == 7                                      && Save
  473.  
  474.       SAVE TO colors.mem ALL LIKE c_*
  475.  
  476.     ENDIF
  477.  
  478.     *
  479.     * Wipe off the silly looking arrows...   :-)
  480.     *
  481.  
  482.     @ 13 - 1        , 0
  483.     @ 13 + 7 + 1, 0
  484.  
  485.     FOR i = 13 TO 13 + 7
  486.       @ i, 9 + 60 + 4         SAY SPACE(1)
  487.       @ i, 9 - 4 SAY SPACE(1)
  488.     NEXT i
  489.  
  490.     *
  491.     * 'Undim' the pick list region.
  492.     *
  493.  
  494.     SET_ATTR(GET_ATTR(), 2, 9, 10, 34)
  495.  
  496.   ELSEIF LASTKEY() == 27
  497.  
  498.     *
  499.     * Let ACHOICE() know we are done with it.
  500.     *
  501.  
  502.     RETURN 0
  503.  
  504.   ENDIF
  505.  
  506. ENDIF
  507.  
  508. *
  509. * Return value indicating 'continue'.  This is returned if no keystroke
  510. *   exception interesting to us ocurred OR <Enter> was pressed.
  511. *
  512.  
  513. RETURN 2
  514.  
  515. ******************************************************************************
  516. ******************************************************************************
  517. ******************************************************************************
  518.  
  519. PROCEDURE COLORSEL
  520.  
  521. *
  522. * Determine the ~CURRENT~ IDL attribute value of the color set chosen.
  523. *
  524. * This value is used to calculate foreground and background values for
  525. *  Clipper color strings AND to calculate row & column positions for the
  526. *  pointers.  It must be available to the NAVIGATE PROCEDURE...
  527. *
  528.  
  529. _attr_ = GET_ATTR(_str_row_, _str_col_)
  530.  
  531. *
  532. * Calculate the Clipper numerical values of the foreground and background
  533. *  colors based on the IDL attribute value.  These variables must be
  534. *  available to the SET KEY "navigation" procedure below.
  535. *
  536.  
  537. fore = _attr_ % 16
  538. back = INT(_attr_ / 16)
  539.  
  540. *
  541. * Calculate the current row and column positions for the arrow pointers
  542. *  based on the current attributes and print them there.  These two
  543. *  variables must also be available to the SET KEY procedure below.
  544. *
  545.  
  546. fore_col = (fore * 4) + 9
  547. back_row = back + 13
  548.  
  549. *
  550. * The color is reset here to the ORIGINAL "normal text" colors in order
  551. *  to print usage messages and arrow pointers.
  552. *
  553.  
  554. SET COLOR TO (c_scr_color)
  555.  
  556. @ 23, INT((80 - LEN("Use the arrow keys to select a color combination")) / 2) SAY ;
  557.              "Use the arrow keys to select a color combination"
  558.  
  559. @ 24, INT((80 - LEN("Press <Enter> to select, <Esc> to abort")) / 2) SAY ;
  560.              "Press <Enter> to select, <Esc> to abort"
  561.  
  562. @ 13 - 1        , fore_col         SAY  CHR(25)
  563. @ 13 + 7 + 1, fore_col         SAY    CHR(24)
  564. @ back_row        , 9 + 60 + 4         SAY  CHR(27)
  565. @ back_row        , 9 - 4 SAY CHR(26)
  566.  
  567. *
  568. * Activate the SET KEY procedure so that the user can move the nifty
  569. *  little arrows around and watch the pretty colors change right before
  570. *  their eyes....   :)
  571. *
  572.  
  573. SET KEY 4 TO NAVIGATE
  574. SET KEY 19  TO NAVIGATE
  575. SET KEY 5    TO NAVIGATE
  576. SET KEY 24  TO NAVIGATE
  577.  
  578. * SET KLUDGE ON
  579.  
  580. *
  581. * All the action takes place in this CONTRIVED WAIT STATE while the SET KEY
  582. *  procedure is activated.  See notes in the procedure below.
  583. *
  584. * If Nantucket would allow INKEY() as a wait state...  <sigh>
  585. *
  586.  
  587. KEYBOARD CHR(0)
  588. INKEY()
  589.  
  590. dummy = " "
  591.  
  592. SET COLOR TO (hidden)
  593. SET INTENSITY OFF
  594. @ 0, 78 GET dummy VALID (LASTKEY() == 13 .OR. LASTKEY() == 27)
  595. READ
  596. SET INTENSITY ON
  597. SET COLOR TO (c_scr_color)
  598.  
  599. @ 0, 78 SAY SPACE(1)
  600. @ 23, 0 SAY SPACE(80)
  601. @ 24, 0 SAY SPACE(80)
  602.  
  603. RELEASE dummy
  604.  
  605. * SET KLUDGE OFF
  606.  
  607. *
  608. * OK, fun's over!  Deactivate the hot keys so that the menu will work.
  609. *
  610.  
  611. SET KEY 4 TO
  612. SET KEY 19  TO
  613. SET KEY 5    TO
  614. SET KEY 24  TO
  615.  
  616. IF LASTKEY() == 13
  617.  
  618.   *
  619.   * Eureka!
  620.   *
  621.   * A new color was chosen while in the wait state.  Let's re-read the
  622.   *  attribute from the sample window.
  623.   *
  624.  
  625.   _attr_ = GET_ATTR(6, 41)
  626.  
  627. ENDIF
  628.  
  629. *
  630. * User ~MAY~ have pressed ESC ...
  631. *  Just in case, re-draw the color of the sample window...
  632. *
  633.  
  634. SET_ATTR(_attr_, 6, 41, 10, 69)
  635.  
  636. *
  637. * Need need to re-calculate new foreground and background attribute values.
  638. * This time, they need to be converted to STRINGS so Clipper can use them!
  639. *
  640. * Note:  These will NOT have changed if the user pressed ESC!
  641. *
  642.  
  643. fore = LTRIM(STR(_attr_ % 16, 0))
  644. back = LTRIM(STR(INT(_attr_ / 16), 0))
  645.  
  646. ******************************************************************************
  647. ******************************************************************************
  648. ******************************************************************************
  649.  
  650. PROCEDURE NAVIGATE
  651.  
  652. *
  653. * This SET KEY procedure moves the attribute pointers up/down/left/right
  654. *   to select foreground & background colors.
  655. *
  656. * 'Wrap around' is supported.  As the arrow pointers move, the sample
  657. *   window background color is updated to reflect the current pointer
  658. *   positions.
  659. *
  660.  
  661. PARAMETERS a, b, c
  662.  
  663. *
  664. * Deactivate the hot-keys so this procedure may not call itself via hot-key.
  665. *
  666.  
  667. SET KEY 5    TO
  668. SET KEY 24  TO
  669. SET KEY 19  TO
  670. SET KEY 4 TO
  671.  
  672. *
  673. * User is attempting to change the background attribute of 'high-intensity'.
  674. *
  675. * TOUGH SHIT!  Re-activate the hot-keys and return.
  676. *
  677.  
  678. IF index == 2 .AND. (LASTKEY() == 5 .OR. LASTKEY() == 24)
  679.  
  680.   *# SNAP XREF OFF
  681.  
  682.   SET KEY 5    TO NAVIGATE
  683.   SET KEY 24  TO NAVIGATE
  684.   SET KEY 19  TO NAVIGATE
  685.   SET KEY 4 TO NAVIGATE
  686.  
  687.   *# SNAP XREF ON
  688.  
  689.   RETURN
  690.  
  691. ENDIF
  692.  
  693. *
  694. * The color was changed to hide the READ.  Change it back to normal.
  695. *
  696.  
  697. SET COLOR TO (c_scr_color)
  698.  
  699. *
  700. * Clear the screen positions where the arrows are CURRENTLY located.
  701. *
  702.  
  703. IF LASTKEY() == 5 .OR. LASTKEY() == 24
  704.   @ back_row, 9 + 60 + 4 SAY SPACE(1)
  705.   @ back_row, 9 - 4 SAY SPACE(1)
  706. ELSE
  707.   @ 13 - 1, fore_col SAY SPACE(1)
  708.   @ 13 + 7 + 1, fore_col SAY SPACE(1)
  709. ENDIF
  710.  
  711. DO WHILE .t.
  712.  
  713.   IF LASTKEY() == 4
  714.  
  715.     *
  716.     * Increment the pointer column by four.  (move right)
  717.     *
  718.  
  719.     fore_col = fore_col + 4
  720.  
  721.     *
  722.     * If we have reached the end, go to the start.  (wrap around)
  723.     *
  724.  
  725.     IF fore_col > 9 + 60
  726.       fore_col = 9
  727.     ENDIF
  728.  
  729.   ELSEIF LASTKEY() == 19
  730.  
  731.     *
  732.     * Decrement the pointer column by four.  (move left)
  733.     *
  734.  
  735.     fore_col = fore_col - 4
  736.  
  737.     *
  738.     * If we have reached the start, go to the end.  (wrap around)
  739.     *
  740.  
  741.     IF fore_col < 9
  742.       fore_col = 9 + 60
  743.     ENDIF
  744.  
  745.   ELSEIF LASTKEY() == 5
  746.  
  747.     *
  748.     * Decrement the row variable.  (go up)
  749.     *
  750.  
  751.     back_row = back_row - 1
  752.  
  753.     *
  754.     * If we have reached the top, go to the bottom.  (wrap around)
  755.     *
  756.  
  757.     IF back_row < 13
  758.       back_row = 13 + 7
  759.     ENDIF
  760.  
  761.   ELSE
  762.  
  763.     *
  764.     * Increment the row variable.  (go down)
  765.     *
  766.  
  767.     back_row = back_row + 1
  768.  
  769.     *
  770.     * If we have reached the bottom, go to the top.  (wrap around)
  771.     *
  772.  
  773.     IF back_row > 13 + 7
  774.       back_row = 13
  775.     ENDIF
  776.  
  777.   ENDIF
  778.  
  779.   *
  780.   * Re-calculate the attribute values based on the new pointer positions.
  781.   *
  782.  
  783.   fore = (fore_col - 9) / 4
  784.   back = back_row - 13
  785.  
  786.   *
  787.   * If foreground # background, we're OK.  Exit the loop.
  788.   *   Otherwise, move to the next pointer position.
  789.   *
  790.  
  791.   IF fore # back
  792.     EXIT
  793.   ENDIF
  794.  
  795. ENDDO
  796.  
  797. *
  798. * Display the pointer arrows in their new positions.
  799. *
  800.  
  801. IF LASTKEY() == 5 .OR. LASTKEY() == 24
  802.   @ back_row, 9 + 60 + 4         SAY CHR(27)
  803.   @ back_row, 9 - 4 SAY CHR(26)
  804. ELSE
  805.   @ 13 - 1        , fore_col SAY CHR(25)
  806.   @ 13 + 7 + 1, fore_col SAY   CHR(24)
  807. ENDIF
  808.  
  809. *
  810. * Update the sample window to reflect current pointer position color.
  811. *
  812.  
  813. SET_ATTR(fore + back * 16, 6, 41, 10, 69)
  814.  
  815. *
  816. * Re-Activate the hot keys just prior to returning.
  817. *
  818.  
  819. *# SNAP XREF OFF
  820.  
  821. SET KEY 5    TO NAVIGATE
  822. SET KEY 24  TO NAVIGATE
  823. SET KEY 19  TO NAVIGATE
  824. SET KEY 4 TO NAVIGATE
  825.  
  826. *# SNAP XREF ON
  827.  
  828. *
  829. * Change color back to hidden.
  830. *
  831.  
  832. SET COLOR TO (hidden)
  833.  
  834. ******************************************************************************
  835. ******************************************************************************
  836. ******************************************************************************
  837.  
  838. PROCEDURE Title
  839.  
  840. SET COLOR TO (c_int_color)
  841.  
  842. @ 3, (80 - 34 - LEN(EXPAND("CHANGE COLOR"))) / 2 + 34 SAY EXPAND("CHANGE COLOR")
  843.  
  844. SET COLOR TO (c_scr_color)
  845.  
  846. * eof colorset.pre
  847.